home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / delcom / PropertySheet.dpr < prev    next >
Encoding:
Text File  |  1996-11-29  |  6.6 KB  |  179 lines
  1. library PropertySheet;
  2. {********************************************************************}
  3. {**  Library : PropertySheet                                       **}
  4. {**                                                                **}
  5. {**  Description : This DLL contains a Windows 95 shell extension  **}
  6. {**  to display the properties of a designated type of file.       **}
  7. {**                                                                **}
  8. {**  This module contains the neccessary entry points for a COM    **}
  9. {**  object. CLSID = AA6A37C0-04F9-11D0-8AFB-00C0DF44273D          **}
  10. {**                                                                **}
  11. {**  Installation Instructions:                                    **}
  12. {**                                                                **}
  13. {**    Run: REGSVR32 PROPERTYSHEET.DLL to register the server      **}
  14. {**    Right click a .??? file and click on the details tab        **}
  15. {**                                                                **}
  16. {**    Run: REGSVR32 /u PROPERTYSHEET.DLL to uninstall the server  **}
  17. {**                                                                **}
  18. {**                                                                **}
  19. {**  Version History :                                             **}
  20. {**                                                                **}
  21. {**  V1.00     First Release version (source+binary)     04/11/96  **}
  22. {**                                                                **}
  23. {** Copyright (C) 1996 Warren F. Young                             **}
  24. {********************************************************************}
  25. uses
  26.   SysUtils,
  27.   OLE2,
  28.   ShlObj,
  29.   Registry,
  30.   Windows,
  31.   PageDefn in 'PageDefn.pas',
  32.   Properties in 'Properties.pas',
  33.   resource in 'Resource.pas',
  34.   ClassFactory in 'ClassFactory.pas',
  35.   Global in 'Global.pas';
  36.  
  37.  
  38. {********************************************************************}
  39. {**  Module Information                                            **}
  40. {********************************************************************}
  41. {$D A Property page shell extension. Copyright (c) 1996 Warren F. Young}
  42.  
  43. {$R Props.res} { resource include }
  44.  
  45.  
  46. {********************************************************************}
  47. {**  Function : DllCanUnloadNow                                    **}
  48. {**                                                                **}
  49. {**  Description : This returns S_OK if it is safe to unload the   **}
  50. {**  library.                                                      **}
  51. {**                                                                **}
  52. {********************************************************************}
  53. function DllCanUnloadNow:HResult; stdcall;
  54. begin
  55.   if RefThisDLL=0 then
  56.     Result:=S_OK
  57.   else
  58.     Result:=S_FALSE;
  59. end;
  60.  
  61.  
  62. {********************************************************************}
  63. {**  Function : DllGetClassObject                                  **}
  64. {**                                                                **}
  65. {**  Description : This function creates a class factory and       **}
  66. {**  returns a pointer to it.                                      **}
  67. {********************************************************************}
  68. function DLLGetClassObject(const clsid: TCLSID; const iid: TIID; var pv):HResult; stdcall;
  69. var
  70.   FClassFactory : TClassFactory;
  71.   hr              : hResult;
  72. begin
  73.   pointer(pv):=nil;
  74.   if not ISEqualCLSID(clsid,CLSID_PropSheet) then
  75.   begin
  76.     Result:=CLASS_E_CLASSNOTAVAILABLE;
  77.     exit;
  78.   end;
  79.  
  80.   FClassFactory:= TClassFactory.Create;
  81.  
  82.   if FClassFactory=nil then
  83.   begin
  84.     Result:=E_OUTOFMEMORY;
  85.     exit;
  86.   end;
  87.  
  88.   hr:=FClassFactory.QueryInterface(iid,pv);
  89.   if FAILED(hr) then
  90.     FClassFactory.Destroy;
  91.  
  92.   Result:=hr;
  93. end;
  94.  
  95.  
  96. {********************************************************************}
  97. {**  Function : DllRegisterServer                                  **}
  98. {**                                                                **}
  99. {**  Description : This function tries to register the shell       **}
  100. {**  extension into the Paint.Picture's list of shell extensions   **}
  101. {********************************************************************}
  102. function DllRegisterServer:HResult;
  103. var
  104.   ModuleFilename : array[0..255] of char;
  105.   Registry : TRegistry;
  106.   KeyName  : string;
  107. begin
  108.   Registry:=TRegistry.Create; {create a registry manipulation object}
  109.  
  110.   GetModuleFilename(hInstance,ModuleFilename,sizeof(ModuleFilename)-1);
  111.   with Registry do
  112.   begin
  113.     RootKey:=HKEY_CLASSES_ROOT;
  114.  
  115.     {** Register the shell extension class **}
  116.     OpenKey('\CLSID\'+StrCLSID_PropSheet,TRUE); { open/create the key }
  117.     WriteString('',StrDescription);
  118.     OpenKey('InprocServer32',TRUE);
  119.     WriteString('',ModuleFilename);
  120.     WriteString('ThreadingModel','Apartment');
  121.  
  122.     {** Register the shell extension part **}
  123.     OpenKey('\.mww',TRUE);
  124.     KeyName := ReadString('');
  125.     if Keyname = '' then
  126.     begin
  127.       WriteString('','MusicWorksFile');
  128.       OpenKey('\.mww',TRUE);
  129.       KeyName := ReadString('');
  130.     end;
  131.     OpenKey('\'+KeyName+'\shellex\PropertySheetHandlers\PropSheet_WFY',TRUE);
  132.     WriteString('',StrCLSID_PropSheet);
  133.   end;
  134.  
  135.   Registry.Destroy;
  136.   Result:=S_OK;
  137. end;
  138.  
  139.  
  140. {********************************************************************}
  141. {**  Function : DllUnregisterServer                                **}
  142. {**                                                                **}
  143. {**  Description : This function tries to unregister the shell     **}
  144. {**  extension from the Paint.Picture's list of shell extensions   **}
  145. {********************************************************************}
  146. function DllUnregisterServer:HResult;
  147. var
  148.   Registry : TRegistry;
  149.   KeyName  : string;
  150. begin
  151.   Registry:=TRegistry.Create;
  152.  
  153.   with Registry do
  154.   begin
  155.     RootKey:=HKEY_CLASSES_ROOT;
  156.     OpenKey('\CLSID',FALSE); { move to HKEY_CLASSES_ROOT\CLSID }
  157.     DeleteKey(StrCLSID_PropSheet); { remove the shell extension class key }
  158.  
  159.     OpenKey('\.mww',TRUE);
  160.     KeyName := ReadString('');
  161.     OpenKey('\'+KeyName+'\shellex\PropertySheetHandlers\PropSheet_WFY',FALSE);
  162.     DeleteKey('PropSheet_WFY'); { remove the property sheet setting from registry }
  163.   end;
  164.   Registry.Destroy;
  165.   Result:=S_OK;
  166. end;
  167.  
  168.  
  169.  
  170. {********************************************************************}
  171. exports
  172.   DllGetClassObject   name 'DllGetClassObject',
  173.   DllCanUnloadNow     name 'DllCanUnloadNow',                                                   
  174.   DllRegisterServer   name 'DllRegisterServer',
  175.   DllUnregisterServer name 'DllUnregisterServer';
  176.  
  177. begin
  178. end.
  179.